
 1000  *SAVE S.PRODOS.QUIT
 1010  *--------------------------------
 1020  CH     .EQ $24
 1030  CV     .EQ $25
 1040  ERRCOD .EQ $DE
 1050  *--------------------------------
 1060  BUF    .EQ $0280
 1070  *--------------------------------
 1080  SYSTEM .EQ $2000
 1090  *--------------------------------
 1100  MLI    .EQ $BF00
 1110  BITMAP .EQ $BF58
 1120  *--------------------------------
 1130  KEY    .EQ $C000
 1140  S80STOREOFF .EQ $C000
 1150  S80OFF .EQ $C00C
 1160  SALTON .EQ $C00F
 1170  STROBE .EQ $C010
 1180  ROM    .EQ $C082
 1190  *--------------------------------
 1200  HOME   .EQ $FC58
 1210  CLREOL .EQ $FC9C
 1220  RDKEY  .EQ $FD0C
 1230  CROUT  .EQ $FD8E
 1240  COUT   .EQ $FDED
 1250  SETKBD .EQ $FE89
 1260  SETVID .EQ $FE93
 1270  BELL   .EQ $FF3A
 1280  *--------------------------------
 1290         .MA MLI
 1300         JSR MLI
 1310         .DA #$]1,]2
 1320         .EM
 1330  *--------------------------------
 1340         .OR $1000
 1350         .TA $5700
 1360  *--------------------------------
 1370  PRODOS.QUIT
 1380         LDA ROM      TURN ON THE MONITOR ROM
 1390         JSR SETVID   GET BACK TO GOOD OLD-FASHIONED
 1400         JSR SETKBD        DOWN-HOME 40 COLUMN DISPLAY
 1410         STA S80OFF
 1420         STA SALTON   Know what I mean, Vern?
 1430         STA S80STOREOFF
 1440  *---PREPARE BITMAP---------------
 1450         LDX #$17
 1460         LDA #1     Mark $BFxx in use
 1470         STA BITMAP,X
 1480         DEX
 1490         LDA #0       Most pages are free
 1500  .1     STA BITMAP,X
 1510         DEX
 1520         BPL .1
 1530         LDA #$CF     $0000-01FF, $0400-07FF in use
 1540         STA BITMAP
 1550  *---DISPLAY PREFIX---------------
 1560  GET.PREFIX
 1570         JSR HOME
 1580         JSR CROUT
 1590         LDA #Q.PRFX
 1600         STA MSG.ADDR
 1610         LDA /Q.PRFX
 1620         STA MSG.ADDR+1
 1630         JSR PRINT.MESSAGE
 1640         LDA #3       VTAB 4
 1650         STA CV  
 1660         JSR CROUT    MAKE IT 5
 1670         >MLI C7,PREFIX.PARM
 1680         LDX BUF      # CHARS IN PREFIX
 1690         LDA #0       MARK END OF PREFIX WITH 00
 1700         STA BUF+1,X  SO OUR MESSAGE PRINTER WILL
 1710         LDA #BUF+1        PRINT IT.
 1720         STA MSG.ADDR
 1730         LDA /BUF+1
 1740         STA MSG.ADDR+1
 1750         JSR PRINT.MESSAGE
 1760  *---GET NEW PREFIX---------------
 1770         LDX #0
 1780         DEC CV       MOVE CURSOR TO BEGINNING OF LINE
 1790         JSR CROUT
 1800  NEXT.PREFIX.CHAR
 1810         JSR RDKEY
 1820         CMP #$8D
 1830         BEQ SET.NEW.PREFIX   ...ACCEPT WHAT IS ON SCREEN
 1840         PHA          ERASE PREFIX FROM SCREEN
 1850         JSR CLREOL
 1860         PLA
 1870         CMP #$9B     IS CHAR <ESCAPE>?
 1880         BEQ GET.PREFIX   ...YES, START ALL OVER
 1890         CMP #$98     IS CHAR CTRL-X?
 1900  START.PREFIX.OVER
 1910         BEQ GET.PREFIX    ...START ALL OVER
 1920         CMP #$89     IS CHAR <TAB>?
 1930         BEQ .3       ...YES, RING BELL
 1940         CMP #$88     IS CHAR BACKSPACE?
 1950         BNE .2       ...NO, APPEND TO LINE
 1960         CPX #0       ...BACKSPACE, UNLESS AT BEGINNING
 1970         BEQ .1       AT BEGINNING ALREADY
 1980         DEC CH       BACK UP
 1990         DEX
 2000  .1     JSR CLREOL   CHOP OFF AFTER CURSOR
 2010         JMP NEXT.PREFIX.CHAR
 2020  .2     BCS .4       OTHER CONTROL CHAR < $88
 2030  .3     JSR BELL
 2040         JMP NEXT.PREFIX.CHAR
 2050  .4     CMP #"Z"+1
 2060         BCC .5       ...NOT LOWER CASE
 2070         AND #$DF     CONVERT LOWER CASE TO UPPER
 2080  .5     CMP #"."     ALLOW PERIOD, SLASH, DIGITS
 2090         BCC .3       ...TOO SMALL
 2100         CMP #"Z"+1   ALLOW LETTERS
 2110         BCS .3       ...TOO LARGE
 2120         CMP #"9"+1
 2130         BCC .6       ...PERIOD, SLASH, OR DIGIT
 2140         CMP #"A"
 2150         BCC .3       ...NOT A LEGAL CHARACTER
 2160  .6     INX
 2170         CPX #$27
 2180         BCS START.PREFIX.OVER   ...TOO LONG
 2190         STA BUF,X
 2200         JSR COUT     ECHO THE CHARACTER
 2210         JMP NEXT.PREFIX.CHAR
 2220  *--------------------------------
 2230  SET.NEW.PREFIX
 2240         CPX #0       DID WE CHANGE IT?
 2250         BEQ GET.PATHNAME   ...NO
 2260         STX BUF      ...YES, SO TELL SYSTEM
 2270         >MLI C6,PREFIX.PARM
 2280         BCC GET.PATHNAME   ...NO ERRORS
 2290         JSR BELL     DING, DONG!
 2300         LDA #0       SET .EQ. STATUS
 2310  PFXOVR BEQ START.PREFIX.OVER    ...ALWAYS
 2320  *--------------------------------
 2330  GET.PATHNAME
 2340         JSR HOME
 2350  START.PATHNAME.OVER
 2360         JSR CROUT
 2370         LDA #Q.PATH
 2380         STA MSG.ADDR
 2390         LDA /Q.PATH
 2400         STA MSG.ADDR+1
 2410         JSR PRINT.MESSAGE
 2420         LDA #3       VTAB 4
 2430         STA CV  
 2440         JSR CROUT    MAKE IT 5
 2450         LDX #0
 2460  NEXT.PATHNAME.CHAR
 2470         LDA #$FF     CURSOR CHARACTER
 2480         JSR COUT
 2490         DEC CH       BACK UP OVER CURSOR
 2500  .1     LDA KEY
 2510         BPL .1       ...WAIT TILL KEY PRESSED
 2520         STA STROBE
 2530         CMP #$9B     <ESCAPE>?
 2540         BNE .2       ...NO
 2550         LDA CH       IF AT BEGINNING, GET PREFIX OVER
 2560         BNE GET.PATHNAME      ...ELSE GET PATHNAME OVER
 2570         BEQ PFXOVR
 2580  .2     CMP #$98     CONTROL-X?
 2590  .3     BEQ GET.PATHNAME
 2600         CMP #$89     TAB KEY?
 2610         BEQ .5       ...YES
 2620         CMP #$88     BACKSPACE?
 2630         BNE .4       ...NO
 2640         JMP BACKSPACE.IN.PATHNAME
 2650  *--------------------------------
 2660  .4     BCS .6
 2670  .5     JSR BELL     ...INVALID CHAR, RING BELL
 2680         JMP NEXT.PATHNAME.CHAR
 2690  *--------------------------------
 2700  .6     CMP #$8D
 2710         BEQ SET.NEW.PATHNAME
 2720         CMP #"Z"+1
 2730         BCC .7
 2740         AND #$DF     CHANGE LOWER CASE TO UPPER
 2750  .7     CMP #"."     ACCEPT DOT, SLASH, OR DIGIT
 2760         BCC .5       ...TOO SMALL
 2770         CMP #"Z"+1   ACCEPT LETTERS
 2780         BCS .5       ...TOO LARGE
 2790         CMP #"9"+1
 2800         BCC .8       ...DOT, SLASH, OR DIGIT
 2810         CMP #"A"
 2820         BCC .5       ...NOT A VALID CHARACTER
 2830  .8     PHA          CLEAR BEYOND THIS POINT
 2840         JSR CLREOL
 2850         PLA
 2860         JSR COUT     ECHO THE NEW CHARACTER
 2870         INX
 2880         CPX #$27
 2890         BCS .3       ...NAME TOO LONG
 2900         STA BUF,X    APPEND CHAR TO NAME
 2910         JMP NEXT.PATHNAME.CHAR
 2920  *--------------------------------
 2930  SET.NEW.PATHNAME
 2940         LDA #" "
 2950         JSR COUT
 2960         STX BUF
 2970         >MLI C4,FILE.INFO.PARM
 2980         BCC .1       ...NO ERRORS
 2990         JMP PROCESS.ERROR
 3000  *--------------------------------
 3010  .1     LDA FILTYP   FILE.INFO.PARM+4
 3020         CMP #$FF
 3030         BEQ .2       "SYS" FILE
 3040         LDA #1
 3050         JMP PROCESS.ERROR
 3060  *--------------------------------
 3070  .2     LDA #0
 3080         STA CL.REF   CLOSE.PARM+1, REF NO.
 3090         >MLI CC,CLOSE.PARM
 3100         BCC .3       ...NO ERROR
 3110         JMP PROCESS.ERROR
 3120  *--------------------------------
 3130  .3     LDA ACBITS   FILE.INFO.PARM+3
 3140         AND #1
 3150         BNE .4       ...OKAY TO READ IT
 3160         LDA #$27
 3170         JMP PROCESS.ERROR
 3180  *--------------------------------
 3190  .4     >MLI C8,OPEN.PARM
 3200         BCC .5       ...NO ERRORS
 3210         JMP PROCESS.ERROR
 3220  *--------------------------------
 3230  .5     LDA OP.REF   OPEN.PARM+5, REF NO.
 3240         STA RD.REF   READ.PARM+1, REF NO.
 3250         STA EF.REF   EOF.PARM+1, REF NO.
 3260         >MLI D1,EOF.PARM
 3270         BCC .6       ...NO ERRORS
 3280         JMP PROCESS.ERROR
 3290  *--------------------------------
 3300  .6     LDA FIL.SZ+2    EOF.PARM+4
 3310         BEQ .7       ...NOT TOO LONG
 3320         LDA #$27
 3330         JMP PROCESS.ERROR
 3340  *--------------------------------
 3350  .7     LDA FIL.SZ      EOF.PARM+2
 3360         STA READ.PARM+4
 3370         LDA FIL.SZ+1    EOF.PARM+3
 3380         STA READ.PARM+5
 3390         >MLI CA,READ.PARM
 3400         PHP
 3410         >MLI CC,CLOSE.PARM
 3420         BCC .9
 3430         PLP
 3440  .8     JMP PROCESS.ERROR
 3450  *--------------------------------
 3460  .9     PLP
 3470         BCS .8
 3480         JMP SYSTEM
 3490  *--------------------------------
 3500  BACKSPACE.IN.PATHNAME
 3510         LDA CH       UNLESS ALREADY AT BEGINNING
 3520         BEQ .1       ...WE WERE
 3530         DEX
 3540         LDA #" "
 3550         JSR COUT
 3560         DEC CH  
 3570         DEC CH  
 3580         JSR COUT
 3590         DEC CH  
 3600  .1     JMP NEXT.PATHNAME.CHAR
 3610  *--------------------------------
 3620  PRINT.MESSAGE
 3630         LDX #0
 3640  MSG.LP LDA MSG.LP,X
 3650  MSG.ADDR   .EQ *-2
 3660         BEQ .1
 3670         ORA #$80
 3680         JSR COUT
 3690         INX
 3700         BNE MSG.LP
 3710  .1     RTS
 3720  *--------------------------------
 3730  PROCESS.ERROR
 3740         STA ERRCOD  
 3750         LDA #12      VTAB 13
 3760         STA CV  
 3770         JSR CROUT    MAKE IT 14
 3780         LDA ERRCOD  
 3790         CMP #1
 3800         BNE .1
 3810         LDA #ERQT.1
 3820         STA MSG.ADDR
 3830         LDA /ERQT.1
 3840         STA MSG.ADDR+1
 3850         BNE .3
 3860  .1     CMP #$40
 3870         BEQ .2
 3880         CMP #$44
 3890         BEQ .2
 3900         CMP #$45
 3910         BEQ .2
 3920         CMP #$46
 3930         BEQ .2
 3940         LDA #ERQT.2
 3950         STA MSG.ADDR
 3960         LDA /ERQT.2
 3970         STA MSG.ADDR+1
 3980         BNE .3       ...ALWAYS
 3990  .2     LDA #ERQT.3
 4000         STA MSG.ADDR
 4010         LDA /ERQT.3
 4020         STA MSG.ADDR+1
 4030  .3     JSR PRINT.MESSAGE
 4040         LDA #0       VTAB 1
 4050         STA CV  
 4060         JMP START.PATHNAME.OVER
 4070  *--------------------------------
 4080  Q.PRFX .AS -/ENTER PREFIX (PRESS "RETURN" TO ACCEPT)/
 4090         .HS 00
 4100  Q.PATH .AS -/ENTER PATHNAME OF NEXT APPLICATION/
 4110         .HS 00
 4120  ERQT.1 .HS 87
 4130         .AS -/NOT A TYPE "SYS" FILE/
 4140         .HS 00
 4150  ERQT.2 .HS 87
 4160         .AS -"I/O ERROR            "
 4170         .HS 00
 4180  ERQT.3 .HS 87
 4190         .AS -"FILE/PATH NOT FOUND  "
 4200         .HS 00
 4210  *--------------------------------
 4220  FILE.INFO.PARM
 4230         .DA #10
 4240         .DA BUF
 4250  ACBITS .HS 00
 4260  FILTYP .HS 00
 4270         .BS 13
 4280  *--------------------------------
 4290  OPEN.PARM
 4300         .DA #3
 4310         .DA BUF
 4320         .DA $1800    BUFFER ADDR
 4330  OP.REF .BS 1        REF NO.
 4340  *--------------------------------
 4350  CLOSE.PARM
 4360         .DA #1
 4370  CL.REF .BS 1        REF NO.
 4380  *--------------------------------
 4390  READ.PARM
 4400         .DA #4
 4410  RD.REF .BS 1        REF NO.
 4420         .DA $2000    BUFFER ADDR
 4430         .BS 2        # BYTES TO READ
 4440         .BS 2        # ACTUALLY READ
 4450  *--------------------------------
 4460  EOF.PARM
 4470         .DA #2
 4480  EF.REF .BS 1        REF NO.
 4490  FIL.SZ .BS 3        EOF POSITION
 4500  *--------------------------------
 4510  PREFIX.PARM
 4520         .DA #1
 4530         .DA BUF
 4540  *--------------------------------
 4550         .LIF

